home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 January / macformat-020.iso / Shareware City / Applications / Alpha.5.96 folder / Tcl / SystemCode / getVarValue.tcl < prev    next >
Encoding:
Text File  |  1994-09-04  |  4.5 KB  |  155 lines  |  [TEXT/ALFA]
  1. #############################################################################
  2. #  Report the current value of a global variable, chosen interactively
  3. #  from a list of all active variables.
  4. #
  5. #  If the variable is an array, or its value is too big to fit in an 
  6. #  alertnote, then its contents are listed in a new window, otherwise 
  7. #  the variable's value is displayed in an alertnote.
  8. #
  9. proc getVarValue {} {
  10.     set val [listpick -p {Which var?} [lsort -ignore [info globals]]]
  11.     if {![string length $val]} return
  12.     global $val
  13.     if {![catch {set $val} value]} {
  14.         if {![catch {alertnote "'$val' = $value"}]} {
  15.             return
  16.         } else {
  17.             new -n "* $val *"
  18.             insertText "'$val' = $value"
  19.         }
  20.     } else {
  21.         new -n "* $val *"
  22. #        insertText "'$val' =\r"
  23.         listArray $val
  24.     }
  25.     goto 0
  26. # if 'shrinkWindow' is loaded, call it to trim the output window.
  27.    catch {shrinkWindow 1}
  28.    set win [lindex [winNames -f] 0]
  29.    setWinInfo -w $win dirty 0
  30. }
  31.  
  32. #############################################################################
  33. #  List the name and value of each element of the array $arrName.
  34. #  (Convenient to use as a shell command.)
  35. #
  36. proc listArray {arrName} {
  37.     global $arrName
  38.     set lines {}
  39.     if {![catch {info vars $arrName}]} {
  40.         foreach nm [array names $arrName] {
  41.             set val [expr \$$arrName\($nm\)]
  42.             append lines "\r\"$nm\"\t\{$val\}"
  43.         }
  44.         insertText $lines
  45.     } else {
  46.         alertnote "\"$arrName\" doesn't exist in this context"
  47.     }
  48. }
  49.  
  50. #############################################################################
  51. #  Write out the active definition of the proc $procName.
  52. #  (Convenient to use as a shell command.)
  53. #
  54. proc listProc {procName} {
  55.     set lines {}
  56.     if {![catch {info procs "*$procName*"} procList]} {
  57.         foreach p $procList {
  58.             set pargs [info args $p]
  59.             set arglist {}
  60.             foreach a $pargs {
  61.                 if {[info default $p $a def]} {
  62.                     append arglist " {$a $def}" 
  63.                 } else {
  64.                     append arglist " $a"
  65.                 }
  66.             }
  67.             append lines "\rproc $p {[string trim $arglist]} {"
  68.             append lines [info body $p]
  69.             append lines "}\r"
  70.         }
  71.         insertText $lines
  72.     }
  73. }
  74.  
  75. #############################################################################
  76. # Adjust the dimensions of the current window to match the length (and 
  77. # optionally the width) of the text that it contains.  If shrinkWidth is 
  78. # omitted or set to zero, then only the height of the window is adjusted.
  79. # (Finding the maximum number of characters per line can be annoyingly
  80. # time-consuming for large files).
  81.  
  82. proc shrinkWindow {{shrinkWidth 0}} {
  83.     global defHeight defWidth
  84.     # These constants work for 9-pt Monaco type
  85.     set lineht 11
  86.     set charwd 6.305
  87.     
  88.     set wd [lindex [getGeometry] 2]
  89.     set ht [lindex [getGeometry] 3]
  90.     set top [lindex [getGeometry] 1]
  91.     set left [lindex [getGeometry] 0]
  92. #    if {$top < 60} then {set top 60}
  93. #    moveWin $left $top
  94.     set mxht [expr [lindex [getMainDevice] 3] - $top - 5 -15]
  95.     set mxwd [expr [lindex [getMainDevice] 2] - $left - 5]
  96.     set mnht 120
  97.     set mnwd 200
  98.  
  99.     set htWd [fileHtWd $shrinkWidth]
  100.     set lines [lindex $htWd 0]
  101.     set chars [lindex $htWd 1]
  102.  
  103.     if {$lines <= 1} then {set lines 10}
  104.     
  105.     
  106.     if {$lines > 0} {
  107.         set ht [expr 22 + ( $lineht * (1 + $lines)) ]
  108.     } elseif {$ht > $defHeight} {
  109.         set ht $defHeight
  110.     }
  111.     
  112.     if {$chars > 0} {
  113.         set wd [expr 3 + ( $charwd * (2 + $chars)) ]
  114.     } elseif {$wd > $defWidth} {
  115.         set wd $defWidth
  116.     }
  117.     
  118.     if {$ht > $mxht} then {set ht $mxht}
  119.     if {$wd > $mxwd} then {set wd $mxwd}
  120.     if {$ht < $mnht} then {set ht $mnht}
  121.     if {$wd < $mnht} then {set wd $mnwd}
  122.     sizeWin $wd $ht
  123. }
  124.  
  125. #############################################################################
  126. # Return the number of lines and the maximum number of characters in any 
  127. # line of a file.  It would be nice if there was a built-in command to
  128. # do this (i.e., compiled C code) because this is a pretty slow way to
  129. # get the maximum line width.
  130.  
  131. proc fileHtWd {{checkWidth 0}} {
  132.     set text [getText 0 [maxPos]] 
  133.     
  134.     set lines [split $text "\r"]
  135.     set nlines [llength $lines]
  136.     
  137.     set llen 0
  138.     if {$checkWidth} {
  139.         foreach line $lines {
  140.             regsub {                +∞.*$} $line {} line
  141.             regsub {    } $line {    } line
  142.             set len [string length $line]
  143.             if {[set ntab [llength [split $line "\t"]]] > 1} {
  144.                 set len [expr $len + 3*($ntab-1)]
  145.             }
  146.             if { $len > $llen} {
  147.                 set llen $len
  148.             }
  149.         }
  150.     }
  151. #    alertnote "Text Height : $nlines ; Text Width : $llen "
  152.     return [list $nlines $llen]
  153. }
  154.  
  155.